package Stdlog::Writer::File;

use 5.008;
use strict;
use warnings;
use Hash::Util qw(lock_keys);
use File::Path;
use IO::Handle;
use Stdlog::Formatter;

my %writer_cache;


sub new {
    my ($pkg, $conf) = @_;
    my $self = {
        'fh'        => undef,
        'fname'     => '',
        'err'       => '',
        'fname_fmt' => Stdlog::Formatter->new($conf->{filename}||'')
    };
    bless $self, $pkg;
    lock_keys(%$self);
    return $self;
}


sub logmsg {
    my $self = shift @_;
    my $args = shift @_;

    if( my $fh = $self->open_file($args) ){
        if( $_[-1] =~ /\n$/s ){
            print $fh "@_";
        }else{
            print $fh "@_\n";
        }
    }
}


sub open_file {
    my $self = shift @_;
    my $args = shift @_;
    my $fname = $self->{fname_fmt}->($args);
    my $oldfh = $self->{fh};
    my $newfh;
    if( $fname ne $self->{fname} ){
        close $oldfh if defined $oldfh;
        
        my $path = $fname;
        $path =~ s|[/\\][^/\\]+$||;
        mkpath($path, {});

        if( open $newfh, '>>', $fname ){
            $newfh->autoflush(1);
            $self->{fname} = $fname;
            $self->{fh}    = $newfh;
            $self->{err}   = '';
        }else{
            $self->{fname} = $fname;
            $self->{fh}    = undef;
            $self->{err}   = $!;
        }
        return $self->{fh}
    }else{
        return $oldfh;
    }
}

1;
__END__

=head1 NAME

Stdlog::Writer::File -- file output for stdlog

=head1 SYNOPSIS

  use Stdlog;
  
  

=head1 DESCRIPTION


=head1 CLASS METHODS

=head2 Stdlog::Writer->new(CLASS, OPTS)


=head2 Stdlog::Writer->get(ID)


=head1 OBJECT METHODS


=head1 EXPORTS

None by default.


=head1 SEE ALSO


=head1 AUTHOR

Robert Mah E<lt>rmah@pobox.comE<gt>


=head1 COPYRIGHT AND LICENSE

Copyright (C) 2007 by Robert Mah

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself, either Perl version 5.8.8 or,
at your option, any later version of Perl 5 you may have available.

=cut
